home *** CD-ROM | disk | FTP | other *** search
/ Ian & Stuart's Australian Mac 1993 September / September 93.iso / Archives / Sound / MIDI / MIDI Utilities / MIDI Basic / Casio Voice Print (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1992-07-09  |  11.1 KB  |  375 lines  |  [MSBC/MSBB]
  1.     REM  “Casio Voice Print”
  2.     REM  For the Casio CZ 101, 1000, 3000 and 5000 synthesizers.
  3.     
  4.     REM  This program reads voice voice files in the format of the
  5.     REM      Midimac™ Casio Patch Librarian from Opcode Systems.
  6.     REM  It displays or prints the voices in either the format
  7.     REM      of Casio’s Sound Data Book or in hexadecimal format.
  8.     REM  It requires the Chicago 12 and Monaco 9 point fonts
  9.     REM      and uses no Basic GOTO statements.
  10.  
  11.     REM  It’s a FREE introductory program,
  12.     REM      showing MIDI music programming techniques.
  13.     REM  It is one of a series of programs and tools available from
  14.     REM      ALTECH Systems, Suite 200, 831 Kings Highway
  15.     REM      Shreveport, LA 71104;  tel. (318) 226-1702
  16.     REM  In addition, the $30 MIDIBASIC™ shareware diskette includes:
  17.     REM      •  MIDIBASIC.rsrc, which can be called from within a Microsoft®
  18.     REM          Basic program, giving the programmer access to Midi
  19.     REM          synthesizers and other devices for which commercial software 
  20.     REM          products are unavailable.
  21.     REM      •  MIDIBASIC.BAS, code routines providing the same facilities 
  22.     REM          from within programs compiled under ZBASIC™, etc.
  23.     REM      •  MIDIBASIC™ Casio Voice Librarian, a compiled shareware
  24.     REM          product, available on several bulletin board systems.
  25.     REM      •  MIDIBASIC™ Casio Voice Editor/Librarian,
  26.     REM          in full BASIC source and compiled form.
  27.  
  28.     REM  Copyright ©1986 by Price M. Collins
  29.     REM     57 Raven Road, Trumbull, CT 06611
  30.  
  31.     DIM Voices$(32),Names$(32),x$(3),rectangle%(11)
  32.     DEF FNtd$(j)=RIGHT$("00"+MID$(STR$(INT(j)),2),2)
  33.     DEF FNfd$(j)=FNtd$(j)+"  "
  34.     DEF FNam(j)=ASC(MID$(d$,j,1))
  35.     DEF FNhex2$(j)=RIGHT$("00"+HEX$(j),2)
  36.     DEF FNpad$(d$)=LEFT$(d$+SPACE$(42),42)
  37.     f$="" : REM contains file name; if none, then blank
  38.     printflag=0 : REM 1=line printer output; 0=screen display
  39.     databook=1 : REM 1=sound data format; 0=hexadecimal display
  40.     FOR i=0 TO 11 : READ rectangle%(i) : NEXT : REM erasure dimensions
  41.     DATA 10,345,40,512,35,0,342,512,70,0,342,512
  42.  
  43.     WINDOW 1,,(0,20)-(512,342),3
  44.     <0x40,0x1d35b010> 1,2,"Sound Data Format",(3,3)-(160,17),3
  45.     <0x40,0x1d35b010> 2,1,"Hexadecimal Format",(3,20)-(160,32),3
  46.     <0x40,0x1d35b010> 3,2,"Display",(180,3)-(255,17),3
  47.     <0x40,0x1d35b010> 4,1,"Print",(180,20)-(255,32),3
  48.     GOSUB CreateButton5
  49.  
  50.     MENU 5,0,0,"" : MENU 4,0,0,"" : MENU 3,0,0,"" : MENU 2,0,0,"" : MENU 1,0,0,""
  51.     MENU 1,0,1,"CASIO VOICE PRINT"
  52.     MENU 1,1,1,"About Casio Voice Print…"
  53.     MENU 1,2,1,"Quit"
  54.  
  55.     ON <0x43,0x1d35b010> GOSUB DialogCheck
  56.     ON MENU GOSUB MenuCheck
  57.     ON BREAK GOSUB BreakCheck
  58.     <0x43,0x1d35b010> ON : MENU ON : BREAK ON
  59.  
  60.     WHILE 1 : WEND : REM permanent loop, waiting for operator actions
  61.  
  62. BreakCheck: REM subroutine to defeat combined control and period keys
  63.     RETURN
  64.     
  65. MenuCheck: REM a menu item was selected
  66.     menunumber=MENU(0)
  67.     menuitem=MENU(1) : IF aboutflag THEN RETURN
  68.     MENU OFF
  69.     IF menunumber=1 THEN IF menuitem=1 THEN GOSUB About :ELSE IF menuitem=2 THEN SYSTEM
  70.     MENU ON
  71.     MENU
  72.     RETURN
  73.  
  74. About:
  75.     WINDOW 2,,(12,97)-(500,332),2
  76.     CALL <0x1e,0x1d35b010>(0) : CALL <0x1e,0x08>(4) : CALL <0x1e,0x01>(12)
  77.     PRINT " Casio Voice Print ";
  78.     CALL <0x13,0x1d35b010>(4) : CALL <0x13,0x08>(9)
  79.     PRINT "for the Casio CZ 101, 1000, 3000 & 5000 synthesizers        "
  80.     CALL <0x09,0x1d35b010>(0)
  81.     PRINT " This program reads voice voice files produced by the Midimac™ Casio Patch"
  82.     PRINT " Librarian from Opcode Systems.  It displays or prints the voices in either"
  83.     PRINT " the format of Casio’s Sound Data Book or in hexadecimal format."
  84.     PRINT
  85.     PRINT " It’s a FREE introductory program, showing MIDI music programming techniques."
  86.     PRINT " It is one of a series of programs and tools available from ALTECH Systems,"
  87.     PRINT "   Suite 200, 831 Kings Highway, Shreveport, LA 71104,  tel. (318) 226-1702" : PRINT
  88.     PRINT " In addition to this program, the $30 MIDIBASIC™ shareware diskette includes:"
  89.     PRINT "   • MIDIBASIC.rsrc, which can be called from within a Microsoft® Basic program,"
  90.     PRINT "     giving the programmer access to Midi synthesizers and other devices"
  91.     PRINT "     for which commercial software products are unavailable."
  92.     PRINT "   • MIDIBASIC.BAS, code routines providing the same facilities from within"
  93.     PRINT "     programs compiled under ZBASIC™, etc."
  94.     PRINT "   • MIDIBASIC™ Casio Voice Librarian, a compiled shareware product,"
  95.     PRINT "     available on several bulletin board systems."
  96.     PRINT "   • MIDIBASIC™ Casio Voice Editor/Librarian, in full BASIC source"
  97.     PRINT "     and compiled form, available only from ALTECH Systems." : PRINT
  98.     PRINT " MIDI software by Price Collins and Allen Marsalis";
  99.     <0x40,0x1d35b010> 50,1,"OK",(440,200)-(480,230),1
  100.     REM loop until button is clicked with interrupt to DialogCheck
  101.     aboutflag=1 : WHILE aboutflag : WEND
  102.     RETURN
  103.  
  104. DialogCheck: REM a button was pushed
  105.     <0x43,0x1d35b010> OFF : MENU OFF
  106.     activity=<0x43,0x1d35b010>(0)
  107.     WHILE activity=1
  108.         pushed=<0x43,0x1d35b010>(1)
  109.         WHILE pushed
  110.             <0x40,0x1d35b010> pushed,2
  111.             IF pushed<3 THEN GOSUB SetFormat
  112.             IF pushed=3 OR pushed=4 THEN GOSUB SetDestination
  113.             IF pushed=5 THEN IF f$="" THEN GOSUB ReadFile :ELSE GOSUB CloseFile
  114.             IF pushed>5 AND pushed<10 THEN GOSUB SetRange
  115.             IF pushed=43 OR pushed=44 THEN GOSUB ShowVoices : GOSUB ShowFirstLast
  116.             IF pushed=50 THEN GOSUB CloseAbout
  117.             IF pushed>10 AND pushed<43 THEN GOSUB DisplayFirst
  118.             pushed=0
  119.             WEND
  120.         activity=0
  121.         WEND
  122.     <0x43,0x1d35b010> ON : MENU ON
  123.     RETURN
  124.  
  125. CloseAbout:
  126.     <0x40,0x1d35b010> CLOSE 50
  127.     WINDOW CLOSE 2
  128.     IF printflag=0 AND f$<>"" THEN pushed=first+10
  129.     aboutflag=0
  130.     RETURN
  131.         
  132. SetFormat: REM sound data or hexadecimal button was pushed
  133.     databook=2-pushed
  134.     <0x40,0x1d35b010> 3-pushed,1
  135.     IF printflag=0 AND f$<>"" THEN pushed=first+10
  136.     RETURN
  137.  
  138. SetDestination: REM display or print button was pushed
  139.     IF printflag=pushed-3 THEN RETURN
  140.     printflag=pushed-3
  141.     <0x40,0x1d35b010> 7-pushed,1
  142.     IF f$<>"" THEN GOSUB SetButtons
  143.     RETURN
  144.  
  145. SetRange: REM change to print range
  146.     IF pushed=6 THEN IF first=last THEN BEEP :ELSE first=first+1
  147.     IF pushed=7 THEN IF first=1 THEN BEEP :ELSE first=first-1
  148.     IF pushed=8 THEN IF last=patches THEN BEEP :ELSE last=last+1
  149.     IF pushed=9 THEN IF last=first THEN BEEP :ELSE last=last-1
  150.     GOSUB ShowFirstLast
  151.     <0x40,0x1d35b010> pushed,1
  152.     RETURN
  153.  
  154. ReadFile: REM select, open, read, close a data file; then display first voice
  155.     f$=FILES$(1,"MPD5MPD1")
  156.     REM file types for CZ-101 and 5000, respectively
  157.     IF f$="" THEN RETURN
  158.     OPEN "R",1,f$,146 : FIELD 1,146 AS C$
  159.     d$="" : GET 1 : d$=d$+C$
  160.     patches=FNam(2) : REM get number of patches, 16 or 32
  161.     FOR i=2 TO patches : GET 1 : d$=d$+C$ : NEXT
  162.     GET 1 : d$=d$+LEFT$(C$,2)
  163.     CLOSE 1
  164.     FOR i=1 TO patches : REM load the two main data arrays
  165.         j=146*(i-1)
  166.         Names$(i)=MID$(d$,j+4,FNam(j+3))
  167.         Voices$(i)=MID$(d$,j+21,128)
  168.         NEXT
  169.     FOR i=LEN(f$) TO 1 STEP -1 : REM eliminate leading volumes/folders
  170.         IF MID$(f$,i,1)=":" THEN f$=MID$(f$,i+1) :ELSE NEXT i
  171.     GOSUB EraseButton5 : REM create new button for file closure
  172.     <0x40,0x1d35b010> 5,1,"Close File",(270,10)-(340,25),1
  173.     CALL <0x0e,0x1d35b010>(345,22)
  174.     CALL <0x1e,0x1d35b010>(0) : CALL <0x1e,0x08>(0) : CALL <0x1e,0x01>(12)
  175.     PRINT f$; : REM display file name
  176.     GOSUB SetButtons
  177.     RETURN
  178.  
  179. CloseFile:
  180.     f$="" : GOSUB EraseButton5 : GOSUB ErasePrintButtons
  181.     GOSUB CreateButton5
  182.     RETURN
  183.     
  184. SetButtons:
  185.     GOSUB ErasePrintButtons
  186.     first=1
  187.     IF printflag THEN last=patches : GOSUB CreatePrintButtons :ELSE last=1 : GOSUB CreateDisplayButtons
  188.     RETURN
  189.     
  190. CreateButton5:
  191.     <0x40,0x1d35b010> 5,2,"Open File",(270,10)-(340,25),1
  192.     RETURN
  193.  
  194. CreatePrintButtons: REM display buttons for printing a file
  195.     <0x40,0x1d35b010> 6,1,"Up",(202,90)-(240,103),3
  196.     <0x40,0x1d35b010> 7,1,"Down",(202,120)-(260,133),3
  197.     <0x40,0x1d35b010> 8,1,"Up",(280,90)-(320,103),3
  198.     <0x40,0x1d35b010> 9,1,"Down",(280,120)-(340,133),3
  199.     <0x40,0x1d35b010> 43,1,"Print",(10,95)-(100,108),1
  200.     <0x40,0x1d35b010> 44,1,"Print to Disk",(10,115)-(100,128),1
  201.     GOSUB ShowFirstLast
  202.     RETURN
  203.     
  204. ShowFirstLast:
  205.     CALL <0x1d,0x1d35b010>(4) : CALL <0x1d,0x08>(0) : CALL <0x1d,0x01>(9)
  206.     CALL <0x3e,0x1d35b010>(168,115) : PRINT "From: ";FNtd$(first);"       To: ";FNtd$(last)
  207.     RETURN
  208.  
  209. CreateDisplayButtons: REM voice buttons for selecting screen displays
  210.     CALL <0x1d,0x1d35b010>(4) : CALL <0x1d,0x08>(0) : CALL <0x1d,0x01>(9)
  211.     FOR i=0 TO 15
  212.         CALL <0x14,0x1d35b010>(31*i+13,47)
  213.         PRINT i+1
  214.         <0x40,0x1d35b010> i+11,1,"",(31*i+3,37)-(31*i+17,49),2
  215.         NEXT
  216.     DisplayFirstEnd=(patches=32)
  217.     WHILE DisplayFirstEnd : REM 16 extra buttons for CZ 3000/5000 files
  218.         FOR i=0 TO 15
  219.             CALL <0x14,0x1d35b010>(31*i+13,64)
  220.             PRINT i+17
  221.             <0x40,0x1d35b010> i+27,1,"",(31*i+3,54)-(31*i+17,66),2
  222.             NEXT
  223.         DisplayFirstEnd=0
  224.         WEND
  225.     IF printflag=0 THEN pushed=first+10 : <0x40,0x02> pushed,2
  226.     RETURN
  227.     
  228. EraseButton5:
  229.     <0x40,0x1d35b010> CLOSE 5
  230.     CALL <0x13,0x1d35b010>(VARPTR(rectangle%(0)))
  231.     RETURN
  232.  
  233. ErasePrintButtons:
  234.     FOR i=6 TO 44
  235.         <0x40,0x1d35b010> CLOSE i
  236.         NEXT
  237.     CALL <0x13,0x1d35b010>(VARPTR(rectangle%(4)))
  238.     RETURN
  239.     
  240. DisplayFirst:
  241.     <0x40,0x1d35b010> first+10,1
  242.     <0x40,0x1d35b010> pushed,2
  243.     first=pushed-10
  244.     last=pushed-10
  245.     GOSUB ShowVoices
  246.     RETURN
  247.  
  248. ShowVoices:
  249.     IF pushed<43 THEN OPEN "O",2,"SCRN:"
  250.     IF pushed=43 THEN OPEN "O",2,"LPT1:DIRECT"
  251.     IF pushed=44 THEN temp$=FILES$(0,"Output File Name:") : IF temp$="" THEN RETURN :ELSE OPEN "O",2,temp$,512
  252.     FOR voice=first TO last
  253.         IF printflag=0 THEN CALL <0x1d,0x1d35b010>(VARPTR(rectangle%(8)))
  254.         CALL <0x0c,0x1d35b010>(1,79)
  255.         IF printflag THEN printline$="File: "+f$+"      Tone #"+STR$(voice)+": " :ELSE printline$=""
  256.         CALL <0x1d,0x1d35b010>(4) : CALL <0x1d,0x08>(1) : CALL <0x1d,0x01>(9)
  257.         printline$=printline$+Names$(voice)
  258.         LineOut(printline$)
  259.         IF printflag<>0 OR databook=0 THEN LineOut("")
  260.         d$=Voices$(voice)
  261.         CALL <0x13,0x1d35b010>(4) : CALL <0x13,0x08>(9)
  262.         IF databook THEN GOSUB SoundData :ELSE GOSUB HexPrint
  263.         IF pushed=43 THEN LineOut(CHR$(12))
  264.         IF pushed=44 THEN LineOut(STRING$(10,13))
  265.         NEXT voice
  266.     CLOSE 2
  267.     RETURN
  268.  
  269. HexPrint: REM display or print a patch in hexadecimal format
  270.     CALL <0x09,0x1d35b010>(0)
  271.     FOR i=0 TO 112 STEP 16
  272.         printline$="00"+FNhex2$(i)+":  "
  273.         FOR j=1 TO 15 STEP 2
  274.             printline$=printline$+FNhex2$(FNam(i+j))+FNhex2$(FNam(i+j+1))+" "
  275.             NEXT
  276.         LineOut(printline$)
  277.         NEXT
  278.     RETURN
  279.     
  280. SoundData: REM display or print a patch in sound data book format
  281.     CALL <0x09,0x1d35b010>(4)
  282.     PRINT #2,SPC(12-3*(pushed<43));"Modulation";SPC(2);"       Detune       ";SPC(2);"       Vibrato       ";SPC(2);" Octave  "
  283.     CALL <0x09,0x1d35b010>(0)
  284.     IF printflag THEN LineOut("            __________  ____________________  _____________________  _________")
  285.     LineOut("LineSelect  Ring Noise  +/- Octave Note Fine  Wave Delay Rate Depth  +/- Range")
  286.     pflag=FNam(1) AND 15
  287.     pflag3=pflag AND 3
  288.     printline$="   "+MID$("  1   2 1+1'1+2'",1+4*pflag3,4)+"      "
  289.     FOR j=8 TO 4 STEP -4
  290.         printline$=printline$+MID$("OFF ON ",1+(FNam(16) AND 4*j)/j,3)+"  "
  291.         NEXT
  292.     printline$=printline$+"  "+MID$("+-",1+(FNam(2) AND 1),1)+"    "
  293.     j=FNam(4)
  294.     k=FNam(3)/4
  295.     printline$=printline$+FNtd$(j\12)+"    "+FNtd$(j MOD 12)+"   "+FNtd$(k-(k\16))+"    "
  296.     j=FNam(5) AND 46
  297.     IF j=32 THEN printline$=printline$+"3" :ELSE printline$=printline$+MID$(" 4 2   1",j,1)
  298.     FOR j=6 TO 12 STEP 3
  299.         printline$=printline$+"    "+FNtd$(FNam(j))
  300.         NEXT
  301.     printline$=printline$+"    "
  302.     IF pflag>7 THEN printline$=printline$+"-    1" :ELSE IF pflag>3 THEN printline$=printline$+"+    1" :ELSE printline$=printline$+"     0"
  303.     LineOut(printline$)
  304.     pflag3=pflag3 MOD 2
  305.     FOR h=56 TO 22 STEP -17
  306.         LineOut("")
  307.         printline$=""
  308.         FOR i=1 TO 1+pflag3
  309.             IF h=22 THEN printline$=printline$+"DCA"+STR$(i)+", Key Follow="+STR$(FNam(57*i-40))
  310.             IF h=39 THEN printline$=printline$+"DCW"+STR$(i)+", Key Follow="+STR$(FNam(57*i-38))
  311.             hEquals56=(h=56)
  312.             WHILE hEquals56
  313.                 j=57*i-42
  314.                 printline$=printline$+"DCO"+STR$(i)+", Wave Forms: 1st="
  315.                 m=(FNam(j) AND 224)\32
  316.                 n=(FNam(j+1) AND 192)\64
  317.                 IF m<4 THEN m=m+1 :ELSE IF m>5 THEN m=m+n-1
  318.                 printline$=printline$+MID$(STR$(m),2)+", 2nd="
  319.                 m=(FNam(j) AND 28)\4
  320.                 IF m>5 THEN m=m+n-1
  321.                 printline$=printline$+MID$(STR$(m),2)
  322.                 hEquals56=0
  323.                 WEND
  324.             IF i=1 THEN printline$=FNpad$(printline$)
  325.             NEXT i
  326.         LineOut(printline$)
  327.         IF printflag THEN LineOut("")
  328.         printline$=MID$("Amp   Wave  Pitch ",1+6*(h-22)/17,6)
  329.         FOR i=1 TO 8
  330.             printline$=printline$+STR$(i)+"  "
  331.             NEXT
  332.         IF pflag3 THEN printline$=FNpad$(printline$)+printline$
  333.         LineOut(printline$)
  334.         FOR i=1 TO 3
  335.             x$(i)=""
  336.             NEXT
  337.         FOR i=h TO h+57*pflag3 STEP 57
  338.             x$(1)=x$(1)+"Rate  "
  339.             x$(2)=x$(2)+"Level "
  340.             x$(3)=x$(3)+"    "
  341.             FOR j=i+0 TO i+14 STEP 2
  342.                 m=FNam(j) AND 127
  343.                 IF h=39 THEN m=m-8
  344.                 IF h<56 THEN IF m=0 THEN n=0 :ELSE IF m=119 THEN n=99 :ELSE n=99*m/119+1
  345.                 IF h=56 THEN IF m=0 THEN n=0 :ELSE IF m=127 THEN n=99 :ELSE n=99*m/127+1
  346.                 x$(1)=x$(1)+FNfd$(n)
  347.                 m=FNam(j+1) AND 127
  348.                 n=m
  349.                 IF h=22 AND m>0 THEN n=m-28
  350.                 IF h=39 AND m>0 THEN IF m=127 THEN n=99 :ELSE n=99*m/127+1
  351.                 IF h=56 AND m>63 THEN n=n-4
  352.                 x$(2)=x$(2)+FNfd$(n)
  353.                 IF (FNam(j+1) AND 128) THEN temp$=" sus" :ELSE temp$="    "
  354.                 IF j=i+2*FNam(i-1) THEN temp$=" end" : j=i+15 : REM force end
  355.                 x$(3)=x$(3)+temp$
  356.                 NEXT j
  357.             IF i<79 THEN FOR j=1 TO 3 : x$(j)=FNpad$(x$(j)) : NEXT
  358.             NEXT i
  359.         FOR i=1 TO 3
  360.             LineOut(x$(i))
  361.             NEXT
  362.         NEXT h
  363.     RETURN
  364.     
  365.     SUB LineOut(printline$) STATIC
  366.     SHARED pushed
  367.     REM remove trailing blanks for clean print files
  368.     WHILE RIGHT$(printline$,1)=" "
  369.         printline$=LEFT$(printline$,LEN(printline$)-1)
  370.         WEND
  371.     REM print three leading blanks, if on screen
  372.     PRINT #2,SPC(-3*(pushed<43));printline$
  373.     END SUB
  374.  
  375.